Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/as400/tracker/tracker.bas

BASIC Source File | 1995-11-08 | 5.3 KB | 194 lines

Option Explicit

 ' Variables:
  Global gsTrackerDir  As String       ' directory containing tracker

  ' data base
  Global dbBackup      As database     ' library backup file
  Global tblBackup     As table        ' library backup info

Sub Main ()

 ' Description:
 '  The tracker program begins here

 ' Variables:
  Dim sTitle As String   ' application title

  ' setup global variables
  Call zzSetGlobalVariables

  ' please wait...
  Screen.MousePointer = HOURGLASS

  ' setup application title
  sTitle = "AS/400 Library Backup Tracker"
  App.Title = sTitle

  ' if previous instance of the program running
  ' activate prior instance and end this one
  If App.PrevInstance Then

    '...no more waiting
    Screen.MousePointer = DEFAULT

    ' clear application title to prevent
    ' this occurance for being invoked
    App.Title = gsEMPTY

    ' activate other occurance
    AppActivate sTitle

    ' end this one
    End

  Else

    ' program directory will store database
    gsTrackerDir = App.Path

    ' create database
    Call zzCreateDBIfNotFound

    ' load main form
    Load frmTracker

    ' ...no more waiting
    Screen.MousePointer = DEFAULT

    ' show the main form
    frmTracker.Show

  End If

End Sub

Sub zzCreateDBIfNotFound ()

 ' Description:
 '  Checks for existance of database and gives the
 '  user the option to create it if it does not
 '  exist. If user chooses not to create the database
 '  then will end program.

 ' Variables:
  Dim sDataBaseFile     As String          ' database file name
  Dim sDataBaseWork     As String          ' database work file name
  Dim sTimeStampFile    As String          ' date file created or modified

  ' object variables
  Dim fld0                As New Field     ' data base field
  Dim fld1                As New Field     '  "
  Dim fld2                As New Field     '  "
  Dim fld3                As New Field     '  "
  Dim fld4                As New Field     '  "
  Dim fld5                As New Field     '  "
  Dim fld6                As New Field     '  "
  Dim idxNewBackup1       As New Index     ' primary index
  Dim idxNewBackup2       As New Index     ' secondary index
  Dim tblNewBackup        As New TableDef  ' table definition

  ' setup data base file names
  sDataBaseFile = gsTrackerDir & "\Tracker.MDB"
  sDataBaseWork = gsTrackerDir & "\Tracker.LDB"

  ' see if files exist trying to get date and time
  On Error Resume Next
  sTimeStampFile = FileDateTime(sDataBaseFile)
  On Error GoTo 0

  ' if file doesn't exist then create database
  If sTimeStampFile = gsEMPTY Then

    ' give user option to abort process
    gsMBText = "The TRACKER database does not exist in """
    gsMBText = gsMBText & gsTrackerDir & """. Do you wish to create"
    gsMBText = gsMBText & " the database at this time?"
    gsMBText = gsMBText & " If you select ""No"" TRACKER will end."
    If MsgBox(gsMBText, MB_YESNO Or MB_ICONEXCLAMATION) = IDYES Then

      ' get rid of stray .LDB file
      On Error Resume Next
      Kill sDataBaseWork
      On Error GoTo 0

      ' create database
      On Error Resume Next
      Set dbBackup = CreateDatabase(sDataBaseFile$, DB_LANG_GENERAL)
      If dbBackup Is Nothing Then
        gsMBText = "Could not create TRACKER database."
        If Err <> 0 Then gsMBText = gsMBText & " " & Error$
        MsgBox gsMBText, MB_ICONSTOP
        End
      End If
      On Error GoTo 0

      ' new table name
      tblNewBackup.Name = "Backups"

      ' step up each field and append it
      fld0.Name = "System"
      fld0.Type = DB_TEXT
      fld0.Size = 8
      tblNewBackup.Fields.Append fld0

      fld1.Name = "Library"
      fld1.Type = DB_TEXT
      fld1.Size = 10
      tblNewBackup.Fields.Append fld1

      fld2.Name = "Object"
      fld2.Type = DB_TEXT
      fld2.Size = 10
      tblNewBackup.Fields.Append fld2

      fld3.Name = "When"
      fld3.Type = DB_DATE
      tblNewBackup.Fields.Append fld3

      fld4.Name = "Command"
      fld4.Type = DB_TEXT
      fld4.Size = 10
      tblNewBackup.Fields.Append fld4

      fld5.Name = "Device"
      fld5.Type = DB_TEXT
      fld5.Size = 10
      tblNewBackup.Fields.Append fld5

      fld6.Name = "Volumes"
      fld6.Type = DB_TEXT
      fld6.Size = 60
      tblNewBackup.Fields.Append fld6

      ' create primary index
      idxNewBackup1.Name = "Primary"
      idxNewBackup1.Fields = "System;Library;Object;-When"
      idxNewBackup1.Primary = True
      tblNewBackup.Indexes.Append idxNewBackup1

      ' create secondary index
      idxNewBackup2.Name = "Secondary"
      idxNewBackup2.Fields = "System;Library;Object"
      idxNewBackup2.Primary = False
      tblNewBackup.Indexes.Append idxNewBackup2

      ' append new table object to the tabledefs collection
      dbBackup.TableDefs.Append tblNewBackup

      ' close the file and tell user every thing ok
      dbBackup.Close
      gsMBText = "TRACKER database created in directory """
      gsMBText = gsMBText & gsTrackerDir & """."
      MsgBox gsMBText, MB_ICONINFORMATION

    ' if database not create then cannot continue
    Else
      End
    End If

  End If

End Sub